Personal Computer World 2006 May/PCWMAY06.iso/Software/Trial/ConceptDraw NetDiagrammer/data1.cab/Samples__Basic/SimpleDrawing/StampSample/StampSample.cdb

Text File | 2006-02-08 | 9KB | 136 lines

Sub DrawObjects()
    Dim active_page As Page        'Ссылка на активную страницу текущего документа.
    Dim work_lib As Library        'Ссылка на открытую библиотеку, содержащую использующиеся объекты.
    Dim doc_shape As Shape        'Ссылка на шэйп объекта, помещенного в документ.
    Dim con_shape As Shape        'Ссылка на шэйп 1D-объекта, который служит коннектором.
    Dim lib_con_master As Master    'Ссылка на Master, содержащий 1D-объект, который в документе будет использоваться в качестве коннектора.
    Dim lib_master As Master    'Ссылка на Master, содержащий использующийся объект (не коннектор).

    'Получаем ссылку на активную страницу этого документа. Используем глобальную переменную thisDoc
    'для доступа к объекту Document.
    Set active_page = thisDoc.ActivePage

    'Очистить активную страницу документа от всех находящихся на ней сейчас шэйпов.
    active_page.RemoveAllShapes()

    'Открыть библиотеку, в которой содержатся используемые объекты.
    Set work_lib = thisApp.OpenLib("StampSample.cdl")
    'Проверить, удалось ли открыть библиотеку. Если операция не увенчалась успехом
    'и ссылка на библиотеку равна Null, выдается сообщение об ошибке и выполнение
    'программы прекращается.
    If Null = work_lib Then
        Msgbox("Ne udalos' otkrit' biblioteku StampSample.cdl")
        Exit Sub
    End If

    'Получить ссылку на Master использующегося библиотечного объекта.
    Set lib_master = work_lib.MasterByName("Satellite")
    'Проверить, удалось ли получить ссылку. Если операция не увенчалась успехом
    'и ссылка на Master равна Null, выдается сообщение об ошибке и выполнение
    'программы прекращается.
    If Null = lib_master Then
        Msgbox("Ob'ekt ""Satellite"" ne najden v biblioteke")
        Exit Sub
    End If
    'Используя метод DrawStamp, помещаю в документ целиком библиотечный объект.
    'Нет необходимости создавать его по частям. Шэйп-группа создается как
    'сразу как единое целое по существующему образцу. Поскольку объект
    'должен иметь размер, не совпадающий с размером образца, задаются
    'координаты верхнего левого и правого нижнего угла баунда объекта.
    'Пропорции объекта будут автоматически пересчитаны в соответствии с этими
    'координатами.
    Set doc_shape = active_page.DrawStamp(lib_master.Shape, 1220, 255, 1680, 545)
    'Объекту задается новый угол поворота.
    doc_shape.Angle = -0.872665
    'Помещение текста в объект внутри группы. TextBox является верхним объектом группы,
    'поэтому его индекс равен ShapesNum.
    doc_shape.Shape(doc_shape.ShapesNum()).Text = "Satellite"

    Set lib_master = work_lib.MasterByName("Satellite dish")
    If Null = lib_master Then
        Msgbox("Ob'ekt ""Satellite dish"" ne najden v biblioteke")
        Exit Sub
    End If
    'Используя метод DropStamp, помещаю в документ новый библиотечный объект.
    'Этот шэйп является точной копией образца, ему не нужно делать Resize.
    'Поэтому используется метод DropStamp, в которой задаются только координаты
    'GPin группы.
    Set doc_shape = active_page.DropStamp(lib_master.Shape, 700, 900)
    doc_shape.Shape(doc_shape.ShapesNum()).Text = "Kiev, LuckyNet Co." & Chr(10) &  "Satellite dish"

    'Получить ссылку на Master библиотечного 1D объекта. Он будет использовать как коннектор
    'соединяющий другие объекты документа.
    Set lib_con_master = work_lib.MasterByName("Comm-link")
    If Null = lib_con_master Then
        Msgbox("Ob'ekt ""Comm-link"" ne najden v biblioteke")
        Exit Sub
    End If
    'Соединяю два объекта документа шэйпом, ссылка на который находится в lib_con_master.
    'Для этого снова используется метод DrawStamp. Координаты начала и конца 1D объекта
    'в точности равны координатам центров двух шэйпов, построенных ранее. 1D-объект автоматически
    'будет рассматриваться в качестве коннектора, завязанного на центральные умолчательные
    'коннект-доты.
    active_page.DrawStamp(lib_con_master.Shape, 1500, 400, 700, 900)

    Set doc_shape = active_page.DropStamp(lib_master.Shape, 1200, 1500)
    doc_shape.Shape(doc_shape.ShapesNum()).Text = "Odessa, TeNeT Co." & Chr(10) &  "Satellite dish"
    active_page.DrawStamp(lib_con_master.Shape, 1500, 400, 1200, 1500)

    Set lib_master = work_lib.MasterByName("Microwave Link")
    If Null = lib_master Then
        Msgbox("Ob'ekt ""Microwave Link"" ne najden v biblioteke")
        Exit Sub
    End If
    Set doc_shape = active_page.DropStamp(lib_master.Shape, 900, 1900)
    doc_shape.Shape(doc_shape.ShapesNum()).Text = "Microwave Link"
    active_page.DrawStamp(lib_con_master.Shape, 900, 1900, 1200, 1500)

    Set lib_master = work_lib.MasterByName("Modem")
    If Null = lib_master Then
        Msgbox("Ob'ekt ""Modem"" ne najden v biblioteke")
        Exit Sub
    End If
    Set doc_shape = active_page.DropStamp(lib_master.Shape, 1500, 1900)
    doc_shape.Shape(doc_shape.ShapesNum()).Text = "Modem"
    'Для соединения двух объектов будет использован стандартный SmartConnector ConceptDraw.
    'Координаты начала и конца коннектора равны координатам центров построенных
    'шэйпов. Коннектор автоматически привязывается к центральным умолчательным коннект-дотам.
    'После этого объекту выставляется цвет линии, используя индексное представление цвета.
    active_page.DrawSmartConnector(900, 1900, 1500, 1900).PenColor.Index=231

    Set lib_master = work_lib.MasterByName("Gateway")
    If Null = lib_master Then
        Msgbox("Ob'ekt ""Gateway"" ne najden v biblioteke")
        Exit Sub
    End If
    Set doc_shape = active_page.DrawStamp(lib_master.Shape, 1168, 1989, 1232, 2011)
    doc_shape.Shape(doc_shape.ShapesNum()).Text = "Gateway"
    'Для соединения двух объектов будет использован стандартный Connector ConceptDraw.
    'Координаты начала и конца коннектора равны координатам центров построенных
    'шэйпов. Коннектор автоматически привязывается к центральным умолчательным коннект-дотам.
    active_page.DrawConnector(1500, 1900, 1200, 2000).PenColor.Index=231

    Set lib_master = work_lib.MasterByName("Workstation")
    If Null = lib_master Then
        Msgbox("Ob'ekt ""Workstation"" ne najden v biblioteke")
        Exit Sub
    End If
    Set lib_con_master = work_lib.MasterByName("Line-curve connector")
    If Null = lib_con_master Then
        Msgbox("Ob'ekt ""Line-curve connector"" ne najden v biblioteke")
        Exit Sub
    End If
    active_page.DropStamp(lib_master.Shape, 1200, 2200)
    active_page.DrawSmartConnector(1200, 2200, 1200, 2000).PenColor.Index=231
    active_page.DropStamp(lib_master.Shape, 1600, 2200)
    active_page.DrawSmartConnector(1200, 2200, 1600, 2200).PenColor.Index=231
    active_page.DropStamp(lib_master.Shape, 1600, 2500)
    active_page.DrawStamp(lib_con_master.Shape, 1600, 2200, 1600, 2500)
    active_page.DropStamp(lib_master.Shape, 1200, 2500)
    active_page.DrawSmartConnector(1200, 2500, 1600, 2500).PenColor.Index=231
    active_page.DrawStamp(lib_con_master.Shape, 1200, 2500, 1200, 2200)
    Set doc_shape = active_page.DropStamp(lib_master.Shape, 900, 2350)
    doc_shape.Shape(doc_shape.ShapesNum()).Text = "End User Workstation"
    active_page.DrawSmartConnector(900, 2350, 1200, 2500).PenColor.Index=231
End Sub